home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr52
/
5333de.zip
/
2.PRG
< prev
next >
Wrap
Text File
|
1993-04-03
|
867b
|
41 lines
// Update the client files CA of the Pears
// This variation takes APPEND out of the loop.
clear
private I
Select A
Use CA
zap
append blank
FOR I = 1 TO 6000
Replace CAID with NEW_ID("CA")
? "REC#"+str(I,4)+" "
?? "string= "+str(memory(0),4)+"K "+;
"free = "+str(memory(1),4)+"K "+;
"run = "+str(memory(2),4)+"K "+;
"EMM = "+str(memory(3),4)+"K "
next
Function NEW_ID(P1)
***************************************
*
***************************************
private R,; && returns the latest ID
W,; && saves the previous workarea chosen
D
W = select()
use IDS NEW
locate for DS == PadR(P1, 8)
if found()
D = val(NEWID)+1
R := PadL( D, len(trim(NEWID)), "0")
replace NEWID with R
endif
use
select (W)
return R